home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 2
/
SPACE - Library 2 - Volume 1.iso
/
program
/
619
/
tunes
/
tunes.lst
< prev
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
Macintosh to JP
NeXTSTEP
RISC OS/Acorn
Shift JIS
UTF-8
Wrap
File List
|
1992-08-05
|
37.2 KB
|
1,617 lines
'
' TUNES v1.0
' by Harry Sarber
' Started: 11/30/90
'
@init
@doit
@gone
'
' *******************
'
PROCEDURE init
ON ERROR GOSUB err_handler
prn$="init"
last_filename$=""
CLS
v_rez%=CARD{L~A-4}
h_rez%=CARD{L~A-12}
IF v_rez%>200
bell
ALERT 3," |This program only runs| on color systems!",1,"Ok",void%
END
ELSE
IF h_rez%>320
rez%=1
ELSE
rez%=0
ENDIF
ENDIF
version$="1.0"
rev_date$="08/05/92"
@keep_colors
FOR i%=0 TO 15
SETCOLOR i%,0,0,0
NEXT i%
DIM sa%(16)
DIM c%(16,3)
DIM d%(3)
DIM s%(24,2)
max_notes%=64
DIM voice%(3,max_notes%,8)
DIM m$(3,15)
DIM mline$(3)
DIM spd%(12)
DIM sfn$(3,2)
DIM menu_bar$(50)
DIM letters$(24)
RESTORE letter_data
FOR i%=0 TO 23
READ l$
LET letters$(i%)=l$
NEXT i%
letter_data:
DATA A,G,F,E,D,C,B,A,G,F,E,D,C,B,A,G,F,E,D,C,B,A,G,F
RESTORE speed_data
FOR i%=0 TO 11
READ spd%
spd%(i%)=spd%
NEXT i%
speed_data:
DATA 128,64,32,16,8,4,128,64,32,16,8,4
@question
@stopsign
@exclamation
currentdrive%=GEMDOS(&H19)
currentpath$=CHR$(ASC("A")+GEMDOS(&H19))+":"+DIR$(0)+"\"
LET data_path$=currentpath$
IF EXIST("TUNES.PI1")
IF rez%=1
VOID XBIOS(5,L:-1,L:-1,W:0)
ENDIF
degas_load("TUNES.PI1")
a%=XBIOS(2)-32
FOR i%=0 TO 15 ! Convert Degas colors into
c%(i%,0)=INT(DPEEK(a%)/256) ! separate colors in array c%()
c%(i%,1)=INT((DPEEK(a%) MOD 256)/16)! for use with Setcolor command.
c%(i%,2)=DPEEK(a%) MOD 16
a%=a%+2
NEXT i%
x1=18
y1=159
x2=301
y2=y1+18
GET x1,y1,x2,y2,tmp$
DEFFILL 0,1,1
PBOX x1,y1,x2,y2
GET x1-7,y1-7,x2+7,y1,up$
GET x1-7,y1,x2+7,y2,md$
PUT x1,y1,tmp$
ELSE
SETCOLOR 0,7,7,7
FOR i%=1 TO 15
SETCOLOR i%,0,0,0
NEXT i%
bell
IF rez%=1 ! Reset to medium rez if necessary.
VOID XBIOS(5,L:-1,L:-1,W:rez%)
ENDIF
ALERT 3,"I cannot find TUNES.PI1!| | It must be in the| same path.",1," Bye ",void%
gone
ENDIF
work_note%=1
last_note%=1
men_num%=1
xf=19
sx1%=28
sy1%=89
sx2%=304
sy2%=136
x1=18
y1=159
x2=301
y2=y1+18
FOR j%=1 TO 3
GET x1,y1-40+((j%-1)*20),x2,y2-40+((j%-1)*20),mline$(j%-1)
FOR i%=1 TO 15
IF i%>0 AND i%<13
GET x1+((i%-1)*19)+3,y1+1-40+((j%-1)*20),x1+(i%*19)-3,y2-1-40+((j%-1)*20),m$(j%-1,i%-1)
ELSE
IF i%>12 AND i%<14
ELSE
IF i%>13 AND i%<16
GET x1+((i%-1)*19)+7,y1+4-40+((j%-1)*20),x1+(i%*19)-6,y2-4-40+((j%-1)*20),sfn$(j%-1,i%-14)
ENDIF
ENDIF
ENDIF
NEXT i%
NEXT j%
'
GRAPHMODE 2
DEFTEXT 1,,,4
TEXT 195,34,version$
GET 10,63,308,111,whole_staff$
GET 11,112,308,119,top_line$
DEFFILL 0,1,1
PBOX 10,63,308,y1-1
PUT 11,y1-7,top_line$
DEFFILL 8,1,1
FILL x1+279,y1+2
FILL x1+275,y1+10
PUT 10,sy1%-2,whole_staff$
GET sx1%,sy1%-13,sx1%+18,sy2%+1,blank_staff$
GET 83,28,95,32,knob$
GET 225,13,237,45,bar$
PUT 83,14,bar$
GET 120,45,122,51,slider_knob$
GET 123,45,125,51,slider_bar$
PUT 120,45,slider_bar$
GET 120,45,199,51,slider_bar$
DEFFILL 0,1,1
GET 271,6,312,16,blank_note1$
GET 271,16,312,26,blank_note2$
DEFTEXT 4,,,6
TEXT 275,15,"Note"
GET 245,32,312,51,blank_voice$
@build_menu_bar
vol%=15
@show_volume_bar
spd%=8
@show_speed_bar
vn%=1
@show_voice(vn%)
new_offset%=0
@show_note_bar
note$=m$(vn%-1,0)
GET 240,8,246,14,blank_ext$
@show_work_note
@set_sound_data
'
rate%=20 ! Rate of Fade-In/Fade-Out
'
@fadein
RETURN
PROCEDURE doit
prn$="doit"
last_filename$=""
SGET screen$
hidden!=FALSE
flat!=FALSE
sharp!=FALSE
dotted!=FALSE
@hide_mouse
filename$=data_path$+"TUNES.TUN"
startup!=TRUE
ld_it
startup!=FALSE
SGET mscreen$
DO
@get_mouse
@check_right_button
@check_y
@check_left_button
LOOP
RETURN
PROCEDURE gone
prn$="gone"
last_filename$=""
CLS
IF rez%=1
VOID XBIOS(5,L:-1,L:-1,W:rez%)
ENDIF
@restore_colors
EDIT
END
RETURN
'
' *******************
'
PROCEDURE get_mouse
MOUSE x%,y%,b%
IF x%>319
SUB x%,320
ENDIF
' PRINT AT(1,23);SPACE$(20)
' PRINT AT(1,23);x%,y%
RETURN
PROCEDURE check_right_button
IF b%=2
@quit
IF answer%=1
gone
ENDIF
ENDIF
RETURN
PROCEDURE check_y
IF y%<=sy1%
@hide_sprite
@show_mouse
ELSE
IF x%>sx1% AND x%<sx2% AND y%>sy1% AND y%<sy2%
@hide_mouse
note%=INT((x%-sx1%)/19)+1
pos%=INT((y%-sy1%)/2)+1
IF (note%<>last_note% OR pos%<>last_pos%)
SPUT mscreen$
PUT (note%-1)*19+sx1%-2,(pos%-1)*2+sy1%-14,note$,7
GRAPHMODE 1
DEFTEXT 6,,,6
IF work_note%<7
TEXT 288,23,letters$(pos%-1)
@play_note
ELSE
TEXT 288,23," "
ENDIF
sprite_hidden!=FALSE
ENDIF
IF (note%<>last_note% OR pos%<>last_pos%)
last_note%=note%
last_pos%=pos%
ENDIF
ELSE
@hide_sprite
@show_mouse
ENDIF
ENDIF
RETURN
PROCEDURE check_left_button
IF b%=1
@note_selected
@slider_selected
@button_selected
@menu_selected
ENDIF
RETURN
'
' ******************
'
PROCEDURE note_selected
IF x%>sx1% AND x%<sx2% AND y%>sy1% AND y%<sy2%
note_location%=INT((x%-sx1%)/19)+1
note%=INT((x%-sx1%)/19)+1+offset%
pos%=INT((y%-sy1%)/2)+1
IF voice%(vn%-1,note%-1,0)=0
IF work_note%<7
@play_note
voice%(vn%-1,note%-1,2)=s%(pos%-1,1)
IF sharp!
voice%(vn%-1,note%-1,3)=s%(pos%-1,0)+1
ELSE
IF flat!
voice%(vn%-1,note%-1,3)=s%(pos%-1,0)-1
ELSE
voice%(vn%-1,note%-1,3)=s%(pos%-1,0)
ENDIF
ENDIF
voice%(vn%-1,note%-1,4)=vol%
voice%(vn%-1,note%-1,6)=(-sharp!*1)+(-flat!*2)
voice%(vn%-1,note%-1,7)=-dotted!
ELSE
voice%(vn%-1,note%-1,2)=0
voice%(vn%-1,note%-1,3)=0
voice%(vn%-1,note%-1,4)=0
voice%(vn%-1,note%-1,6)=0
voice%(vn%-1,note%-1,7)=0
ENDIF
voice%(vn%-1,note%-1,0)=note%
voice%(vn%-1,note%-1,1)=work_note%
voice%(vn%-1,note%-1,5)=pos%
@show_notes(note%-1,note_location%-1)
REPEAT
UNTIL MOUSEK=0
ELSE
voice%(vn%-1,note%-1,0)=0
voice%(vn%-1,note%-1,1)=0
voice%(vn%-1,note%-1,2)=0
voice%(vn%-1,note%-1,3)=0
voice%(vn%-1,note%-1,4)=0
voice%(vn%-1,note%-1,5)=0
voice%(vn%-1,note%-1,6)=0
voice%(vn%-1,note%-1,7)=0
@show_notes(note%-1,note_location%-1)
REPEAT
UNTIL MOUSEK=0
ENDIF
ENDIF
RETURN
PROCEDURE slider_selected
IF x%>82 AND x%<96 AND y%>13 AND y%<44
@set_speed
ENDIF
IF x%>224 AND x%<237 AND y%>13 AND y%<44
@set_volume
ENDIF
IF x%>246 AND x%<312 AND y%>32 AND y%<52
@set_voice
ENDIF
PUT 247,8,note$
IF x%>119 AND x%<198 AND y%>44 AND y%<52
@do_slider
ENDIF
IF x%>103 AND x%<113 AND y%>43 AND y%<53
@move_right
ELSE
IF x%>209 AND x%<218 AND y%>43 AND y%<53
@move_left
ENDIF
ENDIF
RETURN
PROCEDURE button_selected
IF x%>6 AND x%<25 AND y%>6 AND y%<26
@load
ELSE
IF x%>31 AND x%<50 AND y%>6 AND y%<26
@save
ELSE
IF x%>56 AND x%<75 AND y%>6 AND y%<26
@accessories
ELSE
IF x%>6 AND x%<25 AND y%>32 AND y%<52
@write
ELSE
IF x%>31 AND x%<50 AND y%>32 AND y%<52
@play
ELSE
IF x%>56 AND x%<75 AND y%>32 AND y%<52
@reset
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
RETURN
PROCEDURE menu_selected
IF x%>=x1 AND x%<=x2 AND y%>=y1 AND y%<=y2
GRAPHMODE 1
men_num%=INT((x%-x1)/19)+1
note$=m$(vn%-1,work_note%-1)
IF men_num%>0 AND men_num%<7
work_note%=men_num%
note$=m$(vn%-1,men_num%-1)
PUT 271,6,blank_note1$
DEFTEXT 4,,,6
TEXT 275,15,"Note"
@show_work_note
@hide_mouse
SGET mscreen$
@show_mouse
ELSE
IF men_num%>6 AND men_num%<13
work_note%=men_num%
note$=m$(vn%-1,men_num%-1)
PUT 248,8,note$
PUT 271,6,blank_note1$
DEFTEXT 4,,,6
TEXT 275,15,"Rest"
@show_work_note
@hide_mouse
SGET mscreen$
@show_mouse
ELSE
IF men_num%>12 AND men_num%<14
IF dotted!
DEFFILL 0,1,1
FILL x1+241,y1+2
dotted!=FALSE
IF work_note%>0 AND work_note%<7
@show_work_note
ENDIF
@hide_mouse
SGET mscreen$
@show_mouse
ELSE
DEFFILL 8,1,1
FILL x1+241,y1+2
dotted!=TRUE
IF work_note%>0 AND work_note%<7
@show_work_note
ENDIF
@hide_mouse
SGET mscreen$
@show_mouse
ENDIF
REPEAT
UNTIL MOUSEK=0
ELSE
IF men_num%>13 AND men_num%<15
IF sharp!
sharp!=FALSE
ELSE
sharp!=TRUE
flat!=FALSE
ENDIF
@blank_sfn
@show_sfn
@show_work_note
@hide_mouse
SGET mscreen$
@show_mouse
ELSE
IF men_num%>14 AND men_num%<16
IF flat!
flat!=FALSE
ELSE
sharp!=FALSE
flat!=TRUE
ENDIF
@blank_sfn
@show_sfn
@show_work_note
@hide_mouse
SGET mscreen$
@show_mouse
ENDIF
ENDIF
ENDIF
ENDIF
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
RETURN
'
' ******************
'
PROCEDURE hide_sprite
prn$="hide_sprite"
last_filename$=""
IF sprite_hidden!=FALSE
SPUT mscreen$
sprite_hidden!=TRUE
ENDIF
RETURN
PROCEDURE show_notes(which%,where%)
prn$="show_notes(which%,where%)"
last_filename$=""
PUT where%*19+sx1%-3,sy1%-13,blank_staff$
FOR j%=0 TO 2
IF voice%(j%,which%,0)<>0
PUT where%*19+sx1%-1,(voice%(j%,which%,5)-1)*2+sy1%-14,m$(j%,voice%(j%,which%,1)-1),7
IF voice%(j%,which%,6)=1
PUT where%*19+sx1%-1,(voice%(j%,which%,5)-1)*2+sy1%-14,sfn$(j%,voice%(j%,which%,6)-1),7
ELSE
IF voice%(j%,which%,6)=2
PUT where%*19+sx1%-1,(voice%(j%,which%,5)-1)*2+sy1%-14,sfn$(j%,voice%(j%,which%,6)-1),7
ENDIF
ENDIF
IF voice%(j%,which%,7)=1
GRAPHMODE 2
IF j%=0
DEFTEXT 15,,,6
ELSE
IF j%=1
DEFTEXT 14,,,6
ELSE
DEFTEXT 9,,,6
ENDIF
ENDIF
TEXT where%*19+sx1%+6,(voice%(j%,which%,5)-1)*2+sy1%+1,"."
ENDIF
ENDIF
NEXT j%
SGET mscreen$
RETURN
PROCEDURE blank_sfn
DEFFILL 0,1,1
FILL x1+260,y1+2
FILL x1+256,y1+10
FILL x1+279,y1+2
FILL x1+275,y1+10
RETURN
PROCEDURE show_sfn
prn$="show_sfn"
last_filename$=""
DEFFILL 8,1,1
IF sharp!
FILL x1+260,y1+2
FILL x1+256,y1+10
ELSE
IF flat!
FILL x1+271,y1+2
FILL x1+275,y1+10
ENDIF
ENDIF
RETURN
PROCEDURE play_note
prn$="play_note"
last_filename$=""
IF sharp!
SOUND vn%,vol%,s%(pos%-1,0)+1,s%(pos%-1,1),3
ELSE
IF flat!
SOUND vn%,vol%,s%(pos%-1,0)-1,s%(pos%-1,1),3
ELSE
SOUND vn%,vol%,s%(pos%-1,0),s%(pos%-1,1),3
ENDIF
ENDIF
SOUND vn%,0,0,0,0
RETURN
PROCEDURE show_work_note
prn$="show_work_note"
last_filename$=""
PUT 248,8,m$(vn%-1,work_note%-1)
IF work_note%<7
IF sharp!
PUT 248,8,sfn$(vn%-1,0)
ELSE
IF flat!
PUT 248,8,sfn$(vn%-1,1)
ENDIF
ENDIF
IF dotted!
GRAPHMODE 2
IF vn%=1
DEFTEXT 15,,,6
ELSE
IF vn%=2
DEFTEXT 14,,,6
ELSE
IF vn%=3
DEFTEXT 9,,,6
ENDIF
ENDIF
ENDIF
TEXT 254,23,"."
ENDIF
ENDIF
GET 247,8,260,25,note$
RETURN
'
' *******************
'
PROCEDURE set_voice
prn$="set_voice"
last_filename$=""
vn%=INT((x%-246)/25)+1
@show_voice(vn%)
REPEAT
UNTIL MOUSEK=0
RETURN
PROCEDURE show_voice(which_voice%)
prn$="show_voice(which_voice%)"
last_filename$=""
@hide_mouse
GRAPHMODE 1
PUT 245,32,blank_voice$
DEFFILL 2,1,1
FILL (which_voice%-1)*25+254,37
PUT x1,y1,mline$(which_voice%-1)
IF dotted!=TRUE
DEFFILL 8,1,1
FILL x1+241,y1+2
ENDIF
@show_sfn
@show_work_note
SGET mscreen$
@show_mouse
RETURN
'
' *******************
'
PROCEDURE load
prn$="load"
last_filename$=""
answer%=1
@check_entry
IF entry!
@bell
GET 44,68,276,132,tmp$
GRAPHMODE 1
DEFFILL 0,1,1
PBOX 44,68,276,132
COLOR 14
BOX 48,71,272,129
BOX 47,70,273,130
BOX 44,68,276,132
DEFTEXT 1,,,6
TEXT 90,87,"The Staff has entries!"
TEXT 90,95," Overwrite Staff?"
PUT 54,79,question$
COLOR 15
BOX 123,115,155,125
BOX 122,114,156,126
TEXT 127,123,"Yes"
BOX 163,115,195,125
BOX 162,114,196,126
TEXT 171,123,"No"
@show_mouse
answer%=0
REPEAT
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>122 AND x%<155 AND y%>114 AND y%<125
answer%=1
ELSE
IF x%>162 AND x%<196 AND y%>114 AND y%<125
answer%=2
ENDIF
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL answer%=1 OR answer%=2
PUT 44,68,tmp$
ENDIF
IF answer%=1
@get_filename("Load Data","TUN")
@ld_it
ENDIF
RETURN
PROCEDURE ld_it
prn$="ld_it"
last_filename$=""
IF filename$<>"" AND RIGHT$(filename$)<>"\"
IF EXIST(filename$)
temp%=new_offset%
OPEN "I",#1,filename$
last_filename$=filename$
FOR i%=0 TO max_notes%-1
IF i%>14 AND i%<max_notes%
new_offset%=i%-14
@show_note_bar
ENDIF
FOR j%=0 TO 2
FOR k%=0 TO 7
INPUT #1;vc%
voice%(j%,i%,k%)=vc%
NEXT k%
NEXT j%
NEXT i%
new_offset%=0
old_offset%=0
@show_note_bar
offset%=0
FOR i%=0 TO 14
@show_notes(i%+offset%,i%)
NEXT i%
SGET mscreen$
CLOSE #1
@show_note_bar
ELSE
IF NOT startup!
@bell
GET 76,68,244,132,tmp$
GRAPHMODE 1
DEFFILL 0,1,1
PBOX 76,68,244,132
COLOR 9
BOX 80,71,240,129
BOX 79,70,241,130
BOX 76,68,244,132
DEFTEXT 1,,,6
TEXT 122,87,"That file does"
TEXT 122,95," not exist!"
PUT 86,79,exclamation$
COLOR 10
BOX 148,115,172,125
BOX 147,114,173,126
TEXT 152,123,"Ok"
@show_mouse
answer%=0
REPEAT
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>147 AND x%<172 AND y%>114 AND y%<126
answer%=1
ELSE
bell
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL answer%=1
PUT 76,68,tmp$
ENDIF
ENDIF
ENDIF
RETURN
PROCEDURE reset
prn$="reset"
last_filename$=""
@check_entry
IF entry!
bell
GET 68,68,252,132,tmp$
GRAPHMODE 1
DEFFILL 0,1,1
PBOX 68,68,252,132
COLOR 5
BOX 72,71,248,129
BOX 71,70,249,130
BOX 68,68,252,132
DEFTEXT 1,,,6
TEXT 114,87,"Clear the Staff?"
TEXT 114,103," Are you sure?"
PUT 78,79,question$
COLOR 9
BOX 123,115,155,125
BOX 122,114,156,126
TEXT 127,123,"Yes"
BOX 163,115,195,125
BOX 162,114,196,126
TEXT 171,123,"No"
@show_mouse
answer%=0
REPEAT
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>122 AND x%<155 AND y%>114 AND y%<125
answer%=1
ELSE
IF x%>162 AND x%<196 AND y%>114 AND y%<125
answer%=2
ENDIF
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL answer%=1 OR answer%=2
PUT 68,68,tmp$
IF answer%=1
FOR i%=0 TO 14
PUT i%*19+sx1%-3,sy1%-13,blank_staff$
NEXT i%
FOR i%=0 TO max_notes%-1
FOR j%=0 TO 2
voice%(j%,i%,0)=0
voice%(j%,i%,1)=0
voice%(j%,i%,2)=0
voice%(j%,i%,3)=0
voice%(j%,i%,4)=0
voice%(j%,i%,5)=0
voice%(j%,i%,6)=0
voice%(j%,i%,7)=0
NEXT j%
NEXT i%
SGET mscreen$
ENDIF
ELSE
@no_entries
ENDIF
RETURN
PROCEDURE save
prn$="save"
last_filename$=""
@check_entry
IF entry!
@get_filename("Save Data","TUN")
IF filename$<>"" AND RIGHT$(filename$)<>"\"
answer%=1
IF EXIST(filename$)
@bell
GET 64,68,256,132,tmp$
GRAPHMODE 1
DEFFILL 0,1,1
PBOX 64,68,256,132
COLOR 3
BOX 68,71,252,129
BOX 67,70,253,130
BOX 64,68,256,132
DEFTEXT 1,,,6
TEXT 110,87,"That file exists!"
TEXT 110,95," Overwrite file?"
PUT 74,79,question$
COLOR 13
BOX 123,115,155,125
BOX 122,114,156,126
TEXT 127,123,"Yes"
BOX 163,115,195,125
BOX 162,114,196,126
TEXT 171,123,"No"
@show_mouse
answer%=0
REPEAT
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>122 AND x%<155 AND y%>114 AND y%<125
answer%=1
ELSE
IF x%>162 AND x%<196 AND y%>114 AND y%<125
answer%=2
ENDIF
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL answer%=1 OR answer%=2
PUT 64,68,tmp$
ENDIF
IF answer%=1
temp%=new_offset%
OPEN "O",#1,filename$
last_filename$=filename$
FOR i%=0 TO max_notes%-1
IF i%>14
new_offset%=i%-14
@show_note_bar
ENDIF
FOR j%=0 TO 2
FOR k%=0 TO 7
vc%=voice%(j%,i%,k%)
PRINT #1;vc%
NEXT k%
NEXT j%
NEXT i%
CLOSE #1
new_offset%=temp%
@show_note_bar
ENDIF
ENDIF
ELSE
@no_entries
ENDIF
RETURN
PROCEDURE write
prn$="write"
last_filename$=""
@check_entry
IF entry!
@get_filename("Write GFA","LST")
IF filename$<>"" AND RIGHT$(filename$)<>"\"
temp%=new_offset%
OPEN "O",#1,filename$
last_filename$=filename$
FOR i%=0 TO max_notes%-1
IF i%>14
new_offset%=i%-14
ENDIF
savit!=FALSE
voices%=0
FOR j%=0 TO 2
IF voice%(j%,i%,0)<>0
IF j%=0
voices%=1
ELSE
IF j%=1
ADD voices%,2
ELSE
IF j%=2
ADD voices%,4
ENDIF
ENDIF
ENDIF
d%(j%)=((voice%(j%,i%,7)*spd%((voice%(j%,i%,1)-1))*0.5)+(spd%((voice%(j%,i%,1)-1)))*15/spd%)
savit!=TRUE
SOUND j%+1,0,voice%(j%,i%,3),voice%(j%,i%,2),0
PRINT #1;"SOUND ";j%+1;CHR$(44);0;CHR$(44);voice%(j%,i%,3);CHR$(44);voice%(j%,i%,2);CHR$(44);0
ELSE
d%(j%)=0
ENDIF
sd%=MAX(d%(0),d%(1))
s%=MAX(sd%,d%(2))
NEXT j%
PUT 120,45,slider_bar$
PUT INT((i%*1.23)+120),45,slider_knob$
IF savit!
PRINT #1;"WAVE ";voices%;CHR$(44);voices%;CHR$(44);13;CHR$(44);0;CHR$(44);INT(s%*0.125*1.2)
WAVE voices%,voices%,13,0,INT(s%*0.125)
ENDIF
NEXT i%
FOR j%=0 TO 2
PRINT #1;"SOUND ";j%;CHR$(44);0;CHR$(44);0;CHR$(44);0;CHR$(44);0
SOUND j%,0,0,0,0
NEXT j%
PRINT #1;"WAVE ";0;CHR$(44);0;CHR$(44);0;CHR$(44);0;CHR$(44);0
WAVE 0,0,0,0,0
CLOSE #1
new_offset%=temp%
@show_note_bar
ENDIF
ELSE
@no_entries
ENDIF
RETURN
PROCEDURE play
prn$="play"
last_filename$=""
@check_entry
IF entry!
temp%=new_offset%
FOR i%=0 TO max_notes%-1
sndit!=FALSE
voices%=0
FOR j%=0 TO 2
IF voice%(j%,i%,0)<>0
IF voice%(j%,i%,1)<7
IF j%=0
voices%=1
ELSE
IF j%=1
ADD voices%,2
ELSE
IF j%=2
ADD voices%,4
ENDIF
ENDIF
ENDIF
ENDIF
d%(j%)=((voice%(j%,i%,7)*spd%((voice%(j%,i%,1)-1))*0.5)+(spd%((voice%(j%,i%,1)-1)))*15/spd%)
sndit!=TRUE
SOUND j%+1,0,voice%(j%,i%,3),voice%(j%,i%,2),0
ELSE
d%(j%)=0
ENDIF
sd%=MAX(d%(0),d%(1))
s%=MAX(sd%,d%(2))
NEXT j%
new_offset%=INT(i%*49/63)
@show_note_bar
IF sndit!
WAVE voices%,voices%,13,0,INT(s%*0.125)
ENDIF
NEXT i%
new_offset%=temp%
@show_note_bar
FOR j%=0 TO 2
SOUND j%,0,0,0,0
NEXT j%
WAVE 0,0,0,0,0
PAUSE 1
ELSE
@no_entries
ENDIF
RETURN
PROCEDURE check_entry
prn$="check_entry"
last_filename$=""
entry!=FALSE
FOR i%=0 TO max_notes%-1
FOR j%=0 TO 2
IF voice%(j%,i%,0)<>0
entry!=TRUE
ENDIF
NEXT j%
NEXT i%
RETURN
'
' *******************
'
PROCEDURE set_speed
prn$="set_speed"
last_filename$=""
spd%=15-INT((y%-14)/2)
@show_speed_bar
RETURN
PROCEDURE show_speed_bar
prn$="show_speed_bar"
last_filename$=""
@hide_mouse
GRAPHMODE 1
PUT 84,13,bar$
PUT 83,41-((spd%-1)*2),knob$
DEFTEXT 1,,,4
IF spd%<10
TEXT 84,50,"0"+STR$(spd%)
ELSE
TEXT 84,50,STR$(spd%)
ENDIF
SGET mscreen$
@show_mouse
RETURN
PROCEDURE set_volume
prn$="set_volume"
last_filename$=""
vol%=15-INT((y%-14)/2)
@show_volume_bar
RETURN
PROCEDURE show_volume_bar
prn$="show_volume_bar"
last_filename$=""
@hide_mouse
GRAPHMODE 1
PUT 225,13,bar$
PUT 224,41-((vol%-1)*2),knob$
DEFTEXT 1,,,4
IF vol%<10
TEXT 225,50,"0"+STR$(vol%)
ELSE
TEXT 225,50,STR$(vol%)
ENDIF
SGET mscreen$
@show_mouse
RETURN
PROCEDURE do_slider
prn$="do_slider"
last_filename$=""
REPEAT
MOUSE ox%,oy%,ob%
IF ox%>319
SUB ox%,320
ENDIF
IF ox%>119 AND ox%<198 AND oy%>44 AND oy%<52
new_offset%=INT((ox%-119)/1.58)
@show_note_bar
ELSE
ob%=0
ENDIF
UNTIL ob%=0
IF new_offset%<>offset%
offset%=new_offset%
FOR i%=0 TO 14
show_notes(i%+offset%,i%)
NEXT i%
ENDIF
SGET mscreen$
RETURN
PROCEDURE move_left
prn$="move_left"
last_filename$=""
IF offset%<max_notes%-15
DEFFILL 4,1,1
FILL 208,49
FILL 212,49
GET sx1%+19,sy1%-13,sx2%,sy2%+1,temp$
PUT sx1%,sy1%-13,temp$
INC offset%
DEFFILL 1,1,1
FILL 208,49
FILL 212,49
show_notes(14+offset%,14)
new_offset%=offset%
@show_note_bar
ENDIF
RETURN
PROCEDURE move_right
prn$="move_right"
last_filename$=""
IF offset%>0
DEFFILL 4,1,1
FILL 103,49
FILL 106,49
GET sx1%,sy1%-13,sx2%-17,sy2%+1,temp$
PUT sx1%+19,sy1%-13,temp$
DEC offset%
DEFFILL 1,1,1
FILL 103,49
FILL 106,49
show_notes(offset%,0)
new_offset%=offset%
@show_note_bar
ENDIF
RETURN
PROCEDURE show_note_bar
prn$="show_note_bar"
last_filename$=""
@hide_mouse
PUT 120,45,slider_bar$
PUT INT((new_offset%*1.58)+120),45,slider_knob$
SGET mscreen$
@show_mouse
RETURN
'
' ********************
'
PROCEDURE hide_mouse
prn$="hide_mouse"
last_filename$=""
IF NOT hidden!
hidden!=TRUE
HIDEM
ENDIF
RETURN
PROCEDURE show_mouse
prn$="show_mouse"
last_filename$=""
IF hidden!
hidden!=FALSE
SHOWM
ENDIF
RETURN
'
' ********************
'
PROCEDURE degas_load(a$)
prn$="degas_load(a$)"
last_filename$=""
BLOAD a$,XBIOS(2)-34
a%=XBIOS(2)-32
FOR x=0 TO 15
sa%(x)=DPEEK(a%)
a%=a%+2
NEXT x
RETURN
PROCEDURE set_sound_data
prn$="set_sound_data"
last_filename$=""
RESTORE sound_data
FOR i%=23 TO 0 STEP -1
READ nt,oct
s%(i%,0)=nt
s%(i%,1)=oct
NEXT i%
sound_data:
DATA 6,2
DATA 8,2
DATA 10,2
DATA 12,2
DATA 1,3
DATA 3,3
DATA 5,3
DATA 6,3
DATA 8,3
DATA 10,3
DATA 12,3
DATA 1,4
DATA 3,4
DATA 5,4
DATA 6,4
DATA 8,4
DATA 10,4
DATA 12,4
DATA 1,5
DATA 3,5
DATA 5,5
DATA 6,5
DATA 8,5
DATA 10,5
RETURN
PROCEDURE set_colors
prn$="set_colors"
last_filename$=""
FOR x=0 TO 15
a=XBIOS(7,x,sa%(x))
NEXT x
RETURN
PROCEDURE keep_colors
prn$="keep_colors"
last_filename$=""
LOCAL i%
DEFFN getcol(n%)=XBIOS(7,n%,-1) AND &H777
DIM keepcol%(16)
FOR i%=1 TO 16
keepcol%(i%)=FN getcol(i%-1)
NEXT i%
RETURN
PROCEDURE restore_colors
prn$="restore_colors"
last_filename$=""
LOCAL i%
FOR i%=1 TO 16
SETCOLOR i%-1,keepcol%(i%)
NEXT i%
RETURN
'
' ********************
'
PROCEDURE accessories
prn$="accessories"
last_filename$=""
SGET ascreen$
@fadeout
CLS
IF rez%=1
VOID XBIOS(5,L:-1,L:-1,W:rez%)
ENDIF
MENU menu_bar$()
ON MENU GOSUB menu_handler
temp1%=c%(3,0)
temp2%=c%(3,1)
temp3%=c%(3,2)
FOR i%=0 TO 3
c%(3,i%)=0
NEXT i%
@fadein
leave_accessories!=FALSE
DO
ON MENU
EXIT IF leave_accessories!
LOOP
MENU KILL
@fadeout
IF rez%=1
VOID XBIOS(5,L:-1,L:-1,W:0)
ENDIF
SPUT ascreen$
c%(3,0)=temp1%
c%(3,1)=temp2%
c%(3,2)=temp3%
@fadein
RETURN
PROCEDURE menu_handler
prn$="menu_handler"
last_filename$=""
menu_option$=menu_bar$(MENU(0))
IF menu_option$=" Tunes v1.0"
ALERT 1," TUNES v"+version$+"| by|Harry Sarber| "+rev_date$,1,"Ok",void%
ENDIF
IF menu_option$=" Done "
leave_accessories!=TRUE
ENDIF
MENU OFF
RETURN
PROCEDURE build_menu_bar
prn$="build_menu_bar"
last_filename$=""
RESTORE main_list_menu_data
FOR i%=0 TO 50
READ menu_bar$(i%)
EXIT IF menu_bar$(i%)="***"
NEXT i%
menu_bar$(i%)=""
main_list_menu_data:
DATA Desk," Tunes v1.0"
DATA -------------------
DATA 1,2,3,4,5,6,""
DATA Exit, Done ,""
DATA ***
RETURN
'
' ********************
'
PROCEDURE quit
prn$="quit"
last_filename$=""
bell
GRAPHMODE 2
GET 64,68,256,132,tmp$
DEFFILL 0,1,1
PBOX 64,68,256,132
DEFFILL 3
COLOR 10
BOX 68,71,252,129
BOX 67,70,253,130
BOX 64,68,256,132
DEFTEXT 1,,,6
TEXT 110,87," Quit?"
TEXT 110,103," Are you sure? "
PUT 74,79,question$
COLOR 13
BOX 123,115,155,125
BOX 122,114,156,126
TEXT 127,123,"Yes"
BOX 163,115,195,125
BOX 162,114,196,126
TEXT 171,123,"No"
@show_mouse
answer%=0
REPEAT
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>122 AND x%<155 AND y%>114 AND y%<125
@gone
ELSE
IF x%>162 AND x%<196 AND y%>114 AND y%<125
answer%=2
ENDIF
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL answer%=2
PUT 64,68,tmp$
RETURN
'
' ********************
'
PROCEDURE bell
prn$="bell"
last_filename$=""
PRINT AT(1,1);CHR$(7)
RETURN
PROCEDURE no_entries
prn$="no_entries"
last_filename$=""
bell
GET 48,68,272,132,tmp$
GRAPHMODE 1
DEFFILL 0,1,1
PBOX 48,68,272,132
COLOR 13
BOX 52,71,268,129
BOX 51,70,269,130
BOX 48,68,272,132
DEFTEXT 1,,,6
TEXT 94,95,"There are no entries!"
PUT 58,79,stopsign$
COLOR 6
BOX 148,115,172,125
BOX 147,114,173,126
TEXT 152,123,"Ok"
@show_mouse
answer%=0
REPEAT
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>147 AND x%<172 AND y%>114 AND y%<126
answer%=1
ELSE
bell
ENDIF
REPEAT
UNTIL MOUSEK=0
ENDIF
UNTIL answer%=1
PUT 48,68,tmp$
RETURN
PROCEDURE fadein
FOR j%=1 TO rate% ! Fade-In Loop
percent=j%/rate%
FOR i%=0 TO 15
SETCOLOR i%,c%(i%,0)*percent,c%(i%,1)*percent,c%(i%,2)*percent
NEXT i%
NEXT j%
RETURN
PROCEDURE fadeout
FOR j%=rate% TO 1 STEP -1 ! Fade-In Loop
percent=j%/rate%
FOR i%=0 TO 15
SETCOLOR i%,c%(i%,0)*percent,c%(i%,1)*percent,c%(i%,2)*percent
NEXT i%
NEXT j%
RETURN
PROCEDURE get_filename(t$,e$)
prn$="get_filename(t$,e$)"
last_filename$=""
@hide_mouse
SGET fscreen$
@fadeout
CLS
IF rez%=1 ! Reset to medium rez if necessary.
VOID XBIOS(5,L:-1,L:-1,W:rez%)
ENDIF
temp1%=c%(3,0)
temp2%=c%(3,1)
temp3%=c%(3,2)
FOR i%=0 TO 3
c%(3,i%)=0
NEXT i%
@fadein
path_name$=SPACE$(64) ! Reserve space for path name
drive%=GEMDOS(&H19) ! Get drive number
ptr%=VARPTR(path_name$) ! Define pointer to variable
VOID GEMDOS(&H47,L:ptr%,W:drive%+1)
FOR i%=1 TO 63
IF ASC(MID$(path_name$,i%,1))=0
path_name$=LEFT$(path_name$,i%-1)
i%=63
ENDIF
NEXT i%
PRINT AT(1,1);t$
d$=data_path$+"*."+e$ ! Path to search
@show_mouse
FILESELECT d$,b$,filename$ ! Get a filename
b%=RINSTR(filename$,"\")
path$=LEFT$(filename$,b%)
file$=MID$(filename$,b%+1)
@fadeout
c%(3,0)=temp1%
c%(3,1)=temp2%
c%(3,2)=temp3%
IF rez%=1
VOID XBIOS(5,L:-1,L:-1,W:0)
ENDIF
SPUT fscreen$
@fadein
RETURN
PROCEDURE err_handler
CLOSE #1
GRAPHMODE 1
FOR i%=1 TO 3
PRINT AT(1,1);CHR$(7)
PAUSE 15
NEXT i%
DEFFILL 0,1,1
GET 12,68,308,132,tmp$
PBOX 12,68,308,132
COLOR 3
BOX 16,71,304,129
BOX 15,70,305,130
BOX 12,68,308,132
DEFTEXT 1,,,6
TEXT 58,79,"Error #"+STR$(ERR)+" has occurred!"
TEXT 58,87,"Procedure: "+prn$
TEXT 58,95,"Filename:"
TEXT 58,103,last_filename$
PUT 22,79,stopsign$
COLOR 15
BOX 140,115,180,125
BOX 139,114,181,126
TEXT 144,123," Ok "
@show_mouse
DO
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>138 AND x%<182 AND y%>113 AND y%<127
PUT 12,68,tmp$
REPEAT
UNTIL MOUSEK=0
@check_entry
IF entry!
GRAPHMODE 1
DEFFILL 0,1,1
GET 64,68,256,132,tmp$
PBOX 64,68,256,132
COLOR 3
BOX 68,71,252,129
BOX 67,70,253,130
BOX 64,68,256,132
DEFTEXT 1,,,6
TEXT 110,87,"Try to save data?"
PUT 74,79,question$
COLOR 2
BOX 123,115,155,125
BOX 122,114,156,126
TEXT 127,123,"Yes"
BOX 163,115,195,125
BOX 162,114,196,126
TEXT 171,123,"No"
DO
MOUSE x%,y%,k%
IF x%>319
SUB x%,320
ENDIF
IF k%=1
IF x%>121 AND x%<157 AND y%>113 AND y%<127
PUT 64,68,tmp$
@save
@gone
ELSE
IF x%>161 AND x%<197 AND y%>113 AND y%<127
PUT 64,68,tmp$
@gone
ELSE
@bell
ENDIF
ENDIF
ENDIF
LOOP
ENDIF
@gone
ELSE
@bell
ENDIF
ENDIF
LOOP
RETURN
'
' ***********************
'
PROCEDURE exclamation
RESTORE exclamation_data
exclamation$=SPACE$(518)
FOR i%=0 TO 516 STEP 2
READ pd
DPOKE VARPTR(exclamation$)+i%,pd
NEXT i%
exclamation_data:
DATA 31,31,4,3,3,3,3,49152
DATA 49152,49152,49152,6,6,6,6,24576
DATA 24576,24576,24576,13,13,13,13,45056
DATA 45056,45056,45056,27,27,27,27,55296
DATA 55296,55296,55296,55,55,55,55,60416
DATA 60416,60416,60416,111,111,111,111,62976
DATA 62976,62976,62976,220,220,220,220,15104
DATA 15104,15104,15104,444,444,444,444,15744
DATA 15744,15744,15744,892,892,892,892,16064
DATA 16064,16064,16064,1788,1788,1788,1788,16224
DATA 16224,16224,16224,3580,3580,3580,3580,16304
DATA 16304,16304,16304,7164,7164,7164,7164,16344
DATA 16344,16344,16344,14332,14332,14332,14332,16364
DATA 16364,16364,16364,28668,28668,28668,28668,16374
DATA 16374,16374,16374,57340,57340,57340,57340,16379
DATA 16379,16379,16379,49148,49148,49148,49148,16381
DATA 16381,16381,16381,49148,49148,49148,49148,16381
DATA 16381,16381,16381,57340,57340,57340,57340,16379
DATA 16379,16379,16379,28668,28668,28668,28668,16374
DATA 16374,16374,16374,14332,14332,14332,14332,16364
DATA 16364,16364,16364,7167,7167,7167,7167,65496
DATA 65496,65496,65496,3583,3583,3583,3583,65456
DATA 65456,65456,65456,1788,1788,1788,1788,16224
DATA 16224,16224,16224,892,892,892,892,16064
DATA 16064,16064,16064,444,444,444,444,15744
DATA 15744,15744,15744,220,220,220,220,15104
DATA 15104,15104,15104,111,111,111,111,62976
DATA 62976,62976,62976,55,55,55,55,60416
DATA 60416,60416,60416,27,27,27,27,55296
DATA 55296,55296,55296,13,13,13,13,45056
DATA 45056,45056,45056,6,6,6,6,24576
DATA 24576,24576,24576,3,3,3,3,49152
DATA 49152,49152,49152
RETURN
PROCEDURE question
RESTORE question_data
question$=SPACE$(518)
FOR i%=0 TO 516 STEP 2
READ pd
DPOKE VARPTR(question$)+i%,pd
NEXT i%
question_data:
DATA 31,31,4,16383,16383,16383,16383,65532
DATA 65532,65532,65532,49152,49152,49152,49152,3
DATA 3,3,3,40959,40959,40959,40959,65529
DATA 65529,65529,65529,49151,49151,49151,49151,65533
DATA 65533,65533,65533,57336,57336,57336,57336,16379
DATA 16379,16379,16379,24544,24544,24544,24544,4090
DATA 4090,4090,4090,28608,28608,28608,28608,2038
DATA 2038,2038,2038,12163,12163,12163,12163,33780
DATA 33780,33780,33780,14215,14215,14215,14215,50156
DATA 50156,50156,50156,6023,6023,6023,6023,50152
DATA 50152,50152,50152,7167,7167,7167,7167,33752
DATA 33752,33752,33752,3071,3071,3071,3071,2000
DATA 2000,2000,2000,3582,3582,3582,3582,4016
DATA 4016,4016,4016,1532,1532,1532,1532,8096
DATA 8096,8096,8096,1788,1788,1788,1788,16224
DATA 16224,16224,16224,764,764,764,764,16192
DATA 16192,16192,16192,892,892,892,892,16064
DATA 16064,16064,16064,380,380,380,380,16000
DATA 16000,16000,16000,447,447,447,447,64896
DATA 64896,64896,64896,191,191,191,191,64768
DATA 64768,64768,64768,220,220,220,220,15104
DATA 15104,15104,15104,92,92,92,92,14848
DATA 14848,14848,14848,108,108,108,108,13824
DATA 13824,13824,13824,47,47,47,47,62464
DATA 62464,62464,62464,55,55,55,55,60416
DATA 60416,60416,60416,23,23,23,23,59392
DATA 59392,59392,59392,27,27,27,27,55296
DATA 55296,55296,55296,11,11,11,11,53248
DATA 53248,53248,53248,13,13,13,13,45056
DATA 45056,45056,45056,5,5,5,5,40960
DATA 40960,40960,40960,6,6,6,6,24576
DATA 24576,24576,24576,3,3,3,3,49152
DATA 49152,49152,49152
RETURN
PROCEDURE stopsign
RESTORE stopsign_data
stopsign$=SPACE$(518)
FOR i%=0 TO 516 STEP 2
READ pd
DPOKE VARPTR(stopsign$)+i%,pd
NEXT i%
stopsign_data:
DATA 31,31,4,127,127,127,127,65024
DATA 65024,65024,65024,192,192,192,192,768
DATA 768,768,768,447,447,447,447,64896
DATA 64896,64896,64896,895,895,895,895,65216
DATA 65216,65216,65216,1791,1791,1791,1791,65376
DATA 65376,65376,65376,3583,3583,3583,3583,65456
DATA 65456,65456,65456,7167,7167,7167,7167,65496
DATA 65496,65496,65496,14335,14335,14335,14335,65516
DATA 65516,65516,65516,28671,28671,28671,28671,65526
DATA 65526,65526,65526,57343,57343,57343,57343,65531
DATA 65531,65531,65531,45441,45441,45441,45441,34317
DATA 34317,34317,34317,41089,41089,41089,41089,517
DATA 517,517,517,42215,42215,42215,42215,12901
DATA 12901,12901,12901,42983,42983,42983,42983,12901
DATA 12901,12901,12901,41959,41959,41959,41959,12901
DATA 12901,12901,12901,45543,45543,45543,45543,12805
DATA 12805,12805,12805,47335,47335,47335,47335,12813
DATA 12813,12813,12813,48359,48359,48359,48359,12925
DATA 12925,12925,12925,42215,42215,42215,42215,12925
DATA 12925,12925,12925,41191,41191,41191,41191,637
DATA 637,637,637,45543,45543,45543,45543,34429
DATA 34429,34429,34429,49151,49151,49151,49151,65533
DATA 65533,65533,65533,57343,57343,57343,57343,65531
DATA 65531,65531,65531,28671,28671,28671,28671,65526
DATA 65526,65526,65526,14335,14335,14335,14335,65516
DATA 65516,65516,65516,7167,7167,7167,7167,65496
DATA 65496,65496,65496,3583,3583,3583,3583,65456
DATA 65456,65456,65456,1791,1791,1791,1791,65376
DATA 65376,65376,65376,895,895,895,895,65216
DATA 65216,65216,65216,447,447,447,447,64896
DATA 64896,64896,64896,192,192,192,192,768
DATA 768,768,768,127,127,127,127,65024
DATA 65024,65024,65024
RETURN